home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1999 March / EnigmA AMIGA RUN 35 (1999)(G.R. Edizioni)(IT)[!][issue 1999-03].iso / earkit / mail / thor / thor25_arexx.lha / HeaderManager.thor < prev    next >
Text File  |  1997-04-27  |  12KB  |  380 lines
  1. /* HeaderManager.thor - (c) Neil Bothwick 1996          */
  2. /* $VER: HeaderManager.thor 1.15 (5.1.97)             */
  3. /* Adds, edits and deletes header lines in Thor events  */
  4.  
  5. /* Thanks to ForwardMsg.thor by Petter Nilsen for some  */
  6. /* of the user database code                            */
  7.  
  8. options results
  9.  
  10. /* ;;;needs THOR and bbsread.library functions */
  11. thorport = address()
  12. if left(thorport,5) ~= 'THOR.' then do
  13.     say 'Headers.thor must be run from within Thor.'
  14.     end
  15.  
  16. if ~show('p', 'BBSREAD') then do
  17.     address command
  18.     'run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead'
  19.     'WaitForPort BBSREAD'
  20.     end
  21. ;;;
  22. /* ;;;Set up some stuff */
  23. Changed = 0
  24. drop Menu. HdrMenu.
  25. Menu.1 = '""'
  26. Menu.2 = '"Add new header"'
  27. Menu.3 = '""'
  28. Menu.4 = '"Save and exit"'
  29. Menu.5 = '""'
  30. Menu.6 = '"HELP"'
  31. Menu.Count = 6
  32. HdrMenu.1 = 'Cc:'
  33. HdrMenu.2 = 'Bcc:'
  34. HdrMenu.3 = 'Followup-To:'
  35. HdrMenu.4 = 'Reply-To:'
  36. HdrMenu.5 = 'Custom'
  37. HdrMenu.Count = 5
  38. ThorPath = pragma('D')
  39. ;;;
  40. /* ;;;Read system details */
  41. address(thorport)
  42. drop GLOBALCFG. CURRENT. BBS.
  43. GETGLOBALCONFIG stem GLOBALCFG
  44. CURRENTSYSTEM stem CURRENT
  45. System = CURRENT.BBSNAME
  46.  
  47. address(bbsread)
  48. GETBBSDATA bbsname '"'System'"' stem BBS
  49. MailAddr = BBS.EMAILADDR
  50. DataPath = BBS.BBSPATH
  51. ;;;
  52. /* ;;;Get number of selected event */
  53. address(thorport)
  54. GETSELECTEDEVENT
  55. if(rc ~= 0) then do
  56.     address(thorport)
  57.     errstring = THOR.LASTERROR
  58.     if RC = 5 then errstring = 'Event window not open'
  59.     call ExitMsg(errstring)
  60.     end
  61. EventNo = result
  62. ;;;
  63. /* ;;;Get event details */
  64. address(bbsread)
  65. READBREVENT '"'System'"' eventnr EventNo datastem EVENTDATA tagsstem EVENTTAGS
  66. if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  67. if (EVENTDATA.EVENTTYPE > 1) & (EVENTDATA.EVENTTYPE ~= 9) then call ExitMsg('You can only edit the headers\nfor an Enter, Reply or Forward event')
  68. MsgFile = DataPath||EVENTTAGS.MSGFILE
  69. if pos('.',EVENTTAGS.CONFERENCE) > 0 then IsNews = 1
  70. else IsNews = 0
  71. ;;;
  72. /* ;;;Main loop */
  73. call ReadHeaders
  74. do until StopEdit = 1
  75.     StopEdit = MainMenu()
  76.     end
  77.  
  78. address(thorport)
  79. if Changed = 1 then REQUESTNOTIFY '"You have changed some headers.\nDo you want to save them before exiting?"' '"_Yes|_No"'
  80. if RC = 30 then call ExitMsg(THOR.LASTERROR)
  81. if result = 1 then call WriteHeaders
  82. ;;;
  83.  
  84. exit
  85.  
  86. /* ;;;Show messages to user */
  87. ShowMsg:
  88.     OldAddr = address()
  89.     address(thorport)
  90.     parse arg MsgStr
  91.     REQUESTNOTIFY '"'MsgStr'"' '" OK "'
  92.     address(OldAddr)
  93.     return
  94. ;;;
  95. /* ;;;Exit with a message */
  96. ExitMsg:
  97.     parse arg errmsg
  98.     call ShowMsg(errmsg)
  99.     exit
  100. ;;;
  101. /* ;;;Show main menu */
  102. MainMenu:
  103.     address(thorport)
  104.     do i = 1 to Menu.Count
  105.         interpret 'Header.'NowHeaders+i '=' Menu.i
  106.         end
  107.     Header.Count = NowHeaders + Menu.Count
  108.  
  109.     REQUESTLIST instem Header SIZEGADGET title '"Headers in current message"'
  110.     if RC = 30 then call ExitMsg(THOR.LASTERROR)
  111.     option = result
  112.     if RC = 5 then return 1
  113.     select
  114.         when option = '' then nop
  115.         when option = 'Add new header' then call AddHeader
  116.         when option = 'Save and exit' then do
  117.             call WriteHeaders
  118.             return 1
  119.             end
  120.         when option = 'HELP' then do
  121.             address command 'MultiView `GetEnv THOR/THORPath`docs/HeaderManager.guide PUBSCREEN' GLOBALCFG.PUBSCREENNAME
  122.             end
  123.         otherwise do
  124.             /* Get number of header selected */
  125.             HdrNo = 0
  126.             do i = 1 to NowHeaders
  127.                 if Header.i = option then HdrNo = i
  128.                 end
  129.  
  130.             REQUESTNOTIFY '"'option'\n\nEdit or Delete this header?"' '"_Edit|_Delete"'
  131.             if RC > 0 then ExitMsg(THOR.LASTERROR)
  132.             if result = 1 then call EditHeader
  133.             else call DeleteHeader
  134.             end
  135.         end
  136.     return 0
  137. ;;;
  138. /* ;;;Read headers in current event */
  139. ReadHeaders:
  140.     address(thorport)
  141.     if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
  142.     n = 0
  143.     drop Header.
  144.     Header.Count = 0
  145.     do until eof(msg)
  146.         NextLine = readln(msg)
  147.         if length(NextLine)=0 | right(word(NextLine,1),1) ~= ':' then leave
  148.         n = n + 1
  149.         Header.n = NextLine
  150.         Header.Count = n
  151.         end
  152.     call close(msg)
  153.     MsgHeaders = Header.Count
  154.     NowHeaders = Header.Count
  155.     return
  156. ;;;
  157. /* ;;;Update message file with new headers */
  158. WriteHeaders:
  159.     address(thorport)
  160.     OutFile = 'T:ThorHeaders.'time(s)
  161.     if ~open(msg,MsgFile,'R') then call ExitMsg('Failed to open message file')
  162.     if ~open(out,OutFile,'W') then call ExitMsg('Failed to open temporary file')
  163.     do i = 1 to MsgHeaders
  164.         call readln(msg)
  165.         end
  166.     do i = 1 to NowHeaders
  167.         call writeln(out,Header.i)
  168.         end
  169.     if MsgHeaders = 0 & NowHeaders > 0 then call writeln(out,'')
  170.     do until eof(msg)
  171.         block = readch(msg, 1048576)
  172.         call writech(out,block)
  173.         end
  174.     call close(out)
  175.     call close(msg)
  176.     address command 'copy' OutFile MsgFile
  177.     address command 'delete >NIL:' OutFile
  178.     Changed = 0
  179.     return
  180. ;;;
  181. /* ;;;Add a new header */
  182. AddHeader:
  183.     REQUESTLIST instem HdrMenu SIZEGADGET title '"Choose header to add"'
  184.     if RC = 30 then call ExitMsg(THOR.LASTERROR)
  185.     if RC = 5 then return
  186.     Hdr = result
  187.     select
  188.         when Hdr = 'Cc:' then do
  189.             if IsNews = 0 then call GetAddress
  190.             else do
  191.                 call ShowMsg('Cc: headers not allowed in news')
  192.                 Hdr = ''
  193.                 end
  194.             end
  195.         when Hdr = 'Bcc:' then do
  196.             Hdr = 'bcc:'
  197.             if IsNews = 0 then call GetAddress
  198.             else do
  199.                 call ShowMsg('Bcc: headers not allowed in news')
  200.                 Hdr = ''
  201.                 end
  202.             end
  203.         when Hdr = 'Followup-To:' then do
  204.             if IsNews = 1 then call GetConf
  205.             else do
  206.                 call ShowMsg('Followup-To: headers not allowed in mail')
  207.                 Hdr = ''
  208.                 end
  209.             end
  210.         when Hdr = 'Reply-To:' then do
  211.             call GetAddress
  212.             end
  213.         when Hdr = 'Custom' then do
  214.             REQUESTSTRING title '"Add header"' body '"Enter custom header"' bt '" OK |Cancel"' id '"X-"'
  215.             if RC = 0 then Hdr = result
  216.             else Hdr = ''
  217.             end
  218.         otherwise nop
  219.         end
  220.     if Hdr > '' then do
  221.         NowHeaders = NowHeaders + 1
  222.         Header.Count = NowHeaders
  223.         Header.NowHeaders = Hdr
  224.         Changed = 1
  225.         end
  226.     return
  227. ;;;
  228. /* ;;;Edit a header */
  229. EditHeader:
  230.     HdrType = upper(word(Header.HdrNo,1))
  231.     Hdr = ''
  232.     select
  233.         when HdrType = 'CC:' then do
  234.             Hdr = 'cc:'
  235.             call GetAddress(subword(Header.HdrNo,2))
  236.             end
  237.         when HdrType = 'BCC:' then do
  238.             Hdr = 'bcc:'
  239.             call GetAddress(subword(Header.HdrNo,2))
  240.             end
  241.         when HdrType = 'FOLLOWUP-TO:' then do
  242.             Hdr = 'Followup-To:'
  243.             call GetConf(subword(Header.HdrNo,2))
  244.             end
  245.         when HdrType = 'REPLY-TO:' then do
  246.             Hdr = 'Reply-To:'
  247.             call GetAddress(subword(Header.HdrNo,2))
  248.             end
  249.         otherwise do
  250.             REQUESTSTRING title '"Edit header"' body '"Editing 'Header.HdrNo'"' bt '" OK |Cancel"' id '"'Header.HdrNo'"'
  251.             if RC = 0 then Hdr = result
  252.             end
  253.         end
  254.  
  255.     if Hdr ~= '' then do
  256.         Header.HdrNo = Hdr
  257.         Changed = 1
  258.         end
  259.  
  260.     return
  261. ;;;
  262. /* ;;;Delete a header */
  263. DeleteHeader:
  264.     do i = HdrNo to NowHeaders-1
  265.         interpret 'Header.i = Header.'i+1
  266.         end
  267.     NowHeaders = NowHeaders - 1
  268.     Changed = 1
  269.     return
  270. ;;;
  271. /* ;;;Ask for an email address */
  272. GetAddress:
  273.     parse arg default
  274.     if default > '' then OldHdr = Hdr default                   /* Backup original header */
  275.     else OldHdr = ''
  276.  
  277.     REQUESTSTRING title '"Address header"' body '"Enter email address(es)"' bt '" _OK |_Cancel"' id '"'default'"' maxchars 200
  278.     if RC = 30 then ExitMsg(THOR.LASTERROR)
  279.     if RC = 5 then do                                           /* If nothing entered */
  280.         Hdr = OldHdr
  281.         return
  282.         end
  283.     UserName = result
  284.     UserAddr = ''
  285.     drop USERS. SUG.
  286.     address(bbsread)
  287.     SEARCHBRUSER bbsname '"'System'"' stem USERS search '"'UserName'"' name address alias suggestusersstem SUG
  288.     if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
  289.     Found = result
  290.     if Found > 0 then do                                        /* Match(es) found */
  291.         drop LIST.
  292.         drop USERTAGS.
  293.         LIST.COUNT = USERS.COUNT
  294.  
  295.         do i = 1 to USERS.COUNT                                 /* Build a list of user names */
  296.             LIST.i.USERNR = USERS.i.USERNR
  297.             READBRUSER bbsname '"'System'"' usernr USERS.i.USERNR tagsstem USERTAGS
  298.             if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  299.             LIST.i = USERTAGS.NAME
  300.             if(symbol("USERTAGS.ADDRESS") = "VAR") then LIST.i.ADDRESS = USERTAGS.ADDRESS
  301.             end
  302.  
  303.         address(thorport)                                       /* Select a user */
  304.         drop UserName.
  305.         REQUESTLIST instem LIST outstem USERS title '"Select user:"' dragselect
  306.         if RC = 30 then call ExitMsg(THOR.LASTERROR)
  307.  
  308.         do j = 1 to USERS.COUNT
  309.             do i = 1 to LIST.COUNT                              /* Check for email addresses */
  310.                 if LIST.i = USERS.j then UserAddr = UserAddr','LIST.i.ADDRESS
  311.                 end
  312.             end
  313.  
  314.         end
  315.  
  316.     else do                                                     /* No exact match found */
  317.         if(symbol("SUG.COUNT") = "VAR") then do
  318.             address(thorport)
  319.             drop USERS. UserNum.
  320.             REQUESTLIST instem SUG outstem USERS title '"Select user:"' dragselect
  321.             if RC = 30 then call ExitMsg(THOR.LASTERROR)
  322.             if RC = 5 then do                                   /* If cancelled, use address as typed */
  323.                 Hdr = Hdr UserName
  324.                 return
  325.                 end
  326.             do j = 1 to USERS.COUNT
  327.                 do i = 1 to SUG.COUNT                           /* Get the user number */
  328.                     if SUG.i = USERS.j then UserNum.j = SUG.i.USERNR
  329.                     end
  330.                 end
  331.  
  332.             address(bbsread)                                    /* Get data on users selected */
  333.             do i = 1 to USERS.COUNT
  334.                 drop USERTAGS.
  335.                 READBRUSER bbsname '"'System'"' usernr UserNum.i tagsstem USERTAGS
  336.                 if RC > 0 then call ExitMsg(BBSREAD.LASTERROR)
  337.                 if(symbol("USERTAGS.ADDRESS") = "VAR") then UserAddr = UserAddr','USERTAGS.ADDRESS
  338.                 end
  339.             end
  340.  
  341.         else do                                                 /* No users found in search */
  342.             call ShowMsg('No matching users found')
  343.             UserAddr = ''
  344.             Hdr = OldHdr
  345.             end
  346.         end
  347.  
  348. if left(UserAddr,1) = ',' then UserAddr = substr(UserAddr,2)
  349. if UserAddr > '' then Hdr = Hdr UserAddr
  350. else Hdr = ''
  351. return
  352. ;;;
  353. /* ;;;Ask for a conference name */
  354. GetConf:
  355.     parse arg default
  356.     if default > '' then OldHdr = Hdr default                      /* Backup original header */
  357.     else OldHdr = ''
  358.  
  359.     address(bbsread)
  360.     drop CONFS. SELECTED.
  361.     GETCONFLIST bbsname '"'System'"' stem CONFS
  362.     if RC = 30 then call ExitMsg(BBSREAD.LASTERROR)
  363.     address(thorport)
  364.     REQUESTLIST instem CONFS outstem SELECTED title '"Select newsgroup(s)"' dragselect
  365.     select
  366.         when RC = 30 then call ExitMsg(THOR.LASTERROR)
  367.         when RC = 5 then Hdr = OldHdr
  368.         otherwise do
  369.             Conf = ''
  370.             do i = 1 to SELECTED.COUNT
  371.                 if upper(SELECTED.i) = 'EMAIL' then SELECTED.i = 'poster'
  372.                 Conf = Conf','SELECTED.i
  373.                 end
  374.             Hdr = Hdr substr(Conf,2)
  375.             end
  376.         end
  377.     return
  378. ;;;
  379.  
  380.